home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DELPHI32 / EDIT_UTL / LINKEDIT / LINKEDIT.PAS < prev    next >
Pascal/Delphi Source File  |  1996-06-25  |  9KB  |  311 lines
  1. unit linkedit;
  2.  
  3. { Copyright 1996 - Vanguard Computer Services Pty Ltd, Jim Wowchuk
  4.           Portions copyrighted by Borland International
  5.  
  6.   You are permitted to use, copy and adapt this code providing
  7.   doing so does not violate any other existing copyrights and
  8.   you do not attempt to remove, diminish or restrict the copyrights
  9.   of others that have provided this for you.
  10. }
  11.  
  12. interface
  13.  
  14. uses
  15.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  16.   StdCtrls;
  17.  
  18. type
  19.   TlinkStyle = (lsNormal, lsEllipsis);
  20.  
  21.   TLinkEdit = class(TCustomEdit)
  22.   private
  23.     { Private declarations }
  24.     fButtonWidth : integer;
  25.     fLinkStyle : TLinkStyle;
  26.     fPressed : boolean;
  27.     fTracking : boolean;
  28.     fOnButtonClick : TNotifyEvent;
  29.     procedure StopTracking;
  30.     procedure SetLinkStyle(Value: TLinkStyle);
  31.     procedure TrackButton(X,Y: Integer);
  32.     procedure WMPaint(var Message: TWMPaint); message wm_Paint;
  33.     procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
  34.   protected
  35.     { Protected declarations }
  36.     procedure BoundsChanged;
  37.     procedure EditButtonClick;
  38.     procedure CreateParams(var Params: TCreateParams); override;
  39.     procedure DoEnter; override;
  40.     procedure DoExit; override;
  41.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  42.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  43.       X, Y: Integer); override;
  44.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  45.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  46.       X, Y: Integer); override;
  47.     procedure PaintWindow(DC: HDC); override;
  48.   public
  49.     { Public declarations }
  50.     constructor Create(AOwner: TComponent); override;
  51.     destructor Destroy; override;
  52.   published
  53.     { Published declarations }
  54.     property AutoSelect;
  55.     property AutoSize;
  56.     property BorderStyle;
  57.     property CharCase;
  58.     property Color;
  59.     property Ctl3D;
  60.     property DragCursor;
  61.     property DragMode;
  62.     property Enabled;
  63.     property Font;
  64.     property HideSelection;
  65.     property LinkStyle: TLinkStyle read fLinkStyle write SetLinkStyle default lsNormal;
  66.     property MaxLength;
  67.     property OEMConvert;
  68.     property ParentColor;
  69.     property ParentCtl3D;
  70.     property ParentFont;
  71.     property ParentShowHint;
  72.     property PasswordChar;
  73.     property PopupMenu;
  74.     property ReadOnly;
  75.     property ShowHint;
  76.     property TabOrder;
  77.     property TabStop;
  78.     property Text;
  79.     property Visible;
  80.     property OnButtonClick : TNotifyEvent read fOnButtonClick write fOnButtonClick;
  81.     property OnChange;
  82.     property OnClick;
  83.     property OnDblClick;
  84.     property OnDragDrop;
  85.     property OnDragOver;
  86.     property OnEndDrag;
  87.     property OnEnter;
  88.     property OnExit;
  89.     property OnKeyDown;
  90.     property OnKeyPress;
  91.     property OnKeyUp;
  92.     property OnMouseDown;
  93.     property OnMouseMove;
  94.     property OnMouseUp;
  95.     property OnStartDrag;
  96.   end;
  97.  
  98. procedure Register;
  99.  
  100. implementation
  101.  
  102. procedure Register;
  103. begin
  104.   RegisterComponents('abaCIS', [TLinkEdit]);
  105. end;
  106.  
  107. constructor TLinkEdit.Create(AOwner: TComponent);
  108. begin
  109.   inherited Create(AOwner);
  110.   fButtonWidth := GetSystemMetrics(SM_CXVSCROLL);
  111.   fLinkStyle := lsNormal;
  112. end; // Create
  113.  
  114. destructor TLinkEdit.Destroy;
  115. begin
  116.   inherited Destroy;
  117. end; // Destroy
  118.  
  119. procedure TLinkEdit.CreateParams(var Params: TCreateParams);
  120. begin
  121.   inherited CreateParams(Params);
  122.     { in order to use the EM_SETRECT later, we must make the edit control
  123.       a type MULTILINE }
  124.   with Params do
  125.   begin
  126.     Style := Style or ES_MULTILINE;
  127.   end;
  128. end;  // CreateParams
  129.  
  130. procedure TLinkEdit.BoundsChanged;
  131. var
  132.   R: TRect;
  133. begin
  134.     { Determine the size of the text area in the control - it will
  135.       be smaller by the width of the button if one is present }
  136.   SetRect(R, 0, 0, ClientWidth - 2, ClientHeight + 1); // +1 is workaround for windows paint bug
  137.   if (fLinkStyle <> lsNormal) and focused then Dec(R.Right, fButtonWidth);
  138.   SendMessage(Handle, EM_SETRECT, 0, LongInt(@R));
  139.   Repaint;
  140. end; // BoundsChanged
  141.  
  142. procedure TLinkEdit.SetLinkStyle(Value: TLinkStyle);
  143. begin
  144.     { if the link style is different then change it,
  145.       remember to redraw it if the control is currently
  146.       focused }
  147.   if Value = fLinkStyle then Exit;
  148.   fLinkStyle := Value;
  149.   if not HandleAllocated then exit;
  150.   if focused or (csDesigning in ComponentState) then
  151.     BoundsChanged;
  152. end; // SetLinkStyle
  153.  
  154. procedure TLinkEdit.EditButtonClick;
  155. begin
  156.   if Assigned(fOnButtonClick) then fOnButtonClick(Self);
  157. end; // EditButtonClick
  158.  
  159. procedure TLinkEdit.WMPaint(var Message: TWMPaint);
  160. begin
  161.   PaintHandler(Message)
  162. end; // WMPaint
  163.  
  164. procedure TLinkEdit.WMSetCursor(var Msg: TWMSetCursor);
  165. var
  166.   P: TPoint;
  167. begin
  168.     { Normally, the Edit control changes the Cursor to an I-bar when over
  169.       the control.  We need to set it back to an arrow when over the button }
  170.   if (fLinkStyle <> lsNormal)
  171.   and PtInRect(Rect(Width - FButtonWidth - 4, 0, ClientWidth, ClientHeight), ScreenToClient(P)) then
  172.     begin
  173.     GetCursorPos(P);
  174.     Windows.SetCursor(LoadCursor(0, idc_Arrow));
  175.     end
  176.   else
  177.     inherited;
  178. end; // WMSetCursor
  179.  
  180. procedure TLinkEdit.KeyDown(var Key: Word; Shift: TShiftState);
  181. var
  182.   Msg: TMsg;
  183. begin
  184.     { simulate the mouse pressing the ellipsis button from the
  185.       keyboard by the user pressing CTRL+ENTER }
  186.   if  (fLinkStyle = lsEllipsis)
  187.   and (Key = VK_RETURN)
  188.   and (Shift = [ssCtrl]) then
  189.   begin
  190.     EditButtonClick;
  191.     PeekMessage(Msg, Handle, WM_CHAR, WM_CHAR, PM_REMOVE);
  192.   end
  193.   else
  194.     inherited KeyDown(Key, Shift);
  195. end;  // KeyDown
  196.  
  197.  
  198. procedure TLinkEdit.MouseUp(Button: TMouseButton; Shift: TShiftState;
  199.   X, Y: Integer);
  200. var
  201.   WasPressed: Boolean;
  202. begin
  203.      { if the mouse was released (after being pressed) on the button
  204.        then perform its associated action }
  205.   WasPressed := fPressed;
  206.   StopTracking;
  207.   if (Button = mbLeft) and (fLinkStyle = lsEllipsis) and WasPressed then
  208.     EditButtonClick;
  209.   inherited MouseUp(Button, Shift, X, Y);
  210. end;
  211.  
  212. procedure TLinkEdit.TrackButton(X,Y: Integer);
  213. var
  214.   NewState: Boolean;
  215.   R: TRect;
  216. begin
  217.     { Check if thhe position passed is over the area of the button -
  218.       if so then set the state to pressed and redraw the depressed
  219.       button }
  220.   SetRect(R, ClientWidth - fButtonWidth, 0, ClientWidth, ClientHeight);
  221.   NewState := PtInRect(R, Point(X, Y));
  222.   if fPressed <> NewState then
  223.   begin
  224.     fPressed := NewState;
  225.     InvalidateRect(Handle, @R, False);
  226.   end;
  227. end; // TrackButton
  228.  
  229. procedure TLinkEdit.PaintWindow(DC: HDC);
  230. var
  231.   R: TRect;
  232.   Flags: Integer;
  233.   W: Integer;
  234. begin
  235.     { here's where we draw the little elipsis button when necessary -
  236.       most times it is normal (raised) state, but sometimes it is pressed }
  237.   if (fLinkStyle <> lsNormal) and (focused or (csDesigning in ComponentState)) then
  238.   begin
  239.     SetRect(R, ClientWidth - fButtonWidth, 0, ClientWidth, ClientHeight);
  240.     Flags := 0;
  241.     if FPressed then
  242.       Flags := BF_FLAT;
  243.     DrawEdge(DC, R, EDGE_RAISED, BF_RECT or BF_MIDDLE or Flags);
  244.     Flags := ((R.Right - R.Left) shr 1) - 1 + Ord(fPressed);
  245.     W := Height shr 3;
  246.     if W = 0 then W := 1;
  247.     PatBlt(DC, R.Left + Flags, R.Top + Flags, W, W, BLACKNESS);
  248.     PatBlt(DC, R.Left + Flags - (W * 2), R.Top + Flags, W, W, BLACKNESS);
  249.     PatBlt(DC, R.Left + Flags + (W * 2), R.Top + Flags, W, W, BLACKNESS);
  250.     ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
  251.   end;
  252.   inherited PaintWindow(DC);
  253. end; // PaintWindow
  254.  
  255. procedure TLinkEdit.MouseDown(Button: TMouseButton; Shift: TShiftState;
  256.   X, Y: Integer);
  257. begin
  258.     { Not only must you press the button with the mouse, but it must be
  259.       released over the same button.  If the button has been pressed, we
  260.       need to redraw it depressed, then track the mouse movements to see
  261.       if the user moves off it before releasing. }
  262.   if (Button = mbLeft) and (fLinkStyle <> lsNormal) and focused
  263.   and PtInRect(Rect(Width - fButtonWidth, 0, Width, Height), Point(X,Y)) then
  264.     begin
  265.     MouseCapture := True;
  266.     FTracking := True;
  267.     TrackButton(X, Y);
  268.     end;
  269.   inherited MouseDown(Button, Shift, X, Y);
  270. end; // MouseDown
  271.  
  272. procedure TLinkEdit.MouseMove(Shift: TShiftState; X, Y: Integer);
  273. begin
  274.     { if we are tracking the mouse, the mouse must have been pressed over
  275.       the button part of the control.  Check to see we are still over it. }
  276.   if fTracking then
  277.     TrackButton(X, Y);
  278.   inherited MouseMove(Shift, X, Y);
  279. end; // MouseMove
  280.  
  281. procedure TLinkEdit.StopTracking;
  282. begin
  283.     { we are finished tracking the mouse over the control.  Reset everything }
  284.   if FTracking then
  285.   begin
  286.     TrackButton(-1, -1);
  287.     FTracking := False;
  288.     MouseCapture := False;
  289.   end;
  290. end; // StopTracking;
  291.  
  292. procedure TLinkEdit.DoEnter;
  293. begin
  294.     { In use the elipsis button is only shown when we the control has focus }
  295.   if (fLinkStyle <> lsNormal)
  296.     then BoundsChanged;
  297.   inherited DoEnter;
  298. end; // DoEnter
  299.  
  300.  
  301. procedure TLinkEdit.DoExit;
  302. begin
  303.     { Remove the elipsis button (if present) when we lose focus }
  304.   if (fLinkStyle <> lsNormal)
  305.     then BoundsChanged;
  306.   inherited DoExit;
  307. end;
  308.  
  309. end.
  310.  
  311.